{
  Copyright 2012 Sergey Ostanin

  Licensed under the Apache License, Version 2.0 (the "License");
  you may not use this file except in compliance with the License.
  You may obtain a copy of the License at

      http://www.apache.org/licenses/LICENSE-2.0

  Unless required by applicable law or agreed to in writing, software
  distributed under the License is distributed on an "AS IS" BASIS,
  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
  See the License for the specific language governing permissions and
  limitations under the License.
}

unit DragSpace;

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, PadWidget, VisualUtils,
  MiscUtils, Math, LMessages, LCLType, ExtCtrls;

type
  {$INTERFACES CORBA}
  IDragSpaceHost = interface
    ['ef6419f972193334']
    procedure LayOut;
    procedure NotifyBeginDrag;
    procedure NotifyDragging;
    procedure NotifyEndDrag;
  end;
  {$INTERFACES DEFAULT}

  TDragSpaceFrame = class(TFrame, IMouseListener)
    ApplicationProperties: TApplicationProperties;
    tmDragScroll: TTimer;
    procedure ApplicationPropertiesIdle(Sender: TObject; var Done: Boolean);
    procedure FrameResize(Sender: TObject);
    procedure tmDragScrollTimer(Sender: TObject);
  private type
    TDragState = (dsNone, dsMouseDown, dsDragging);
  private
    FHost: IDragSpaceHost;
    FDragState: TDragState;
    FMouseDownPos: TPoint;
    FDragStartPos: TPoint;
    FDragWidget: TPadWidget;
    FDraggingEnabled: Boolean;
    procedure FinishDrag;
    procedure UpdateDragWidgetPosition;
    { private declarations }
  protected
    function ChildKey(var Message: TLMKey): Boolean; override;
  public
    procedure SetUp(Host: IDragSpaceHost);
    procedure NotifyMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure NotifyMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure NotifyMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure NotifyScroll(VerticalPixels: Integer);

    property DraggingEnabled: Boolean read FDraggingEnabled write FDraggingEnabled;
    property DragWidget: TPadWidget read FDragWidget;
    { public declarations }
  end;

implementation

{$R *.lfm}

{ TDragSpaceFrame }

procedure TDragSpaceFrame.FrameResize(Sender: TObject);
begin
  FHost.LayOut;
end;

procedure TDragSpaceFrame.tmDragScrollTimer(Sender: TObject);
var
  Delta: Integer;
begin
  if FDragState = dsDragging then
  begin
    Delta := DragScrollVertically(Self);
    if Delta <> 0 then
    begin
      FDragStartPos.y := FDragStartPos.y + Delta;
      UpdateDragWidgetPosition;
    end;
  end;
end;

procedure TDragSpaceFrame.ApplicationPropertiesIdle(Sender: TObject;
  var Done: Boolean);
begin
  if (FDragState = dsDragging) and not FDragWidget.Focused then
    FinishDrag;
end;

procedure TDragSpaceFrame.FinishDrag;
var
  WasDragging: Boolean;
begin
  WasDragging := FDragState = dsDragging;
  FDragState := dsNone;
  FDragWidget := nil;
  if WasDragging then
  begin
    FHost.LayOut;
    SetFixedSizeConstraints(Self, 0, 0);
    tmDragScroll.Enabled := FALSE;
  end;
end;

procedure TDragSpaceFrame.UpdateDragWidgetPosition;
var
  r: TRect;
  p: TPoint;
begin
  p := Mouse.CursorPos;
  r.Left := Max(Min(FDragStartPos.x + p.x - FMouseDownPos.x,
    ClientWidth - FDragWidget.Width), 0);
  r.Top := Max(Min(FDragStartPos.y + p.y - FMouseDownPos.y,
    ClientHeight - FDragWidget.Height), 0);
  r.Right := r.Left + FDragWidget.Width;
  r.Bottom := r.Top + FDragWidget.Height;
  FDragWidget.BoundsRect := r;
  FHost.NotifyDragging;
end;

function TDragSpaceFrame.ChildKey(var Message: TLMKey): Boolean;
begin
  if Message.CharCode = VK_ESCAPE then
  begin
    Result := TRUE;
    FinishDrag;
  end
  else
    Result := inherited;
end;

procedure TDragSpaceFrame.SetUp(Host: IDragSpaceHost);
begin
  FHost := Host;
  FDragState := dsNone;
  FDraggingEnabled := TRUE;
  FHost.LayOut;
end;

procedure TDragSpaceFrame.NotifyMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if (Button = mbLeft) and (FDragState = dsNone) and FDraggingEnabled then
  begin
    FDragWidget := Sender as TPadWidget;
    FDragWidget.BringToFront;
    FDragStartPos := Point(FDragWidget.Left, FDragWidget.Top);
    FMouseDownPos := Mouse.CursorPos;
    FDragState := dsMouseDown;
  end;
end;

procedure TDragSpaceFrame.NotifyMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
var
  p: TPoint;
begin
  if ssLeft in Shift then
  begin
    p := Mouse.CursorPos;
    if (FDragState = dsMouseDown) and not SamePoint(p, FMouseDownPos) then
    begin
      FDragState := dsDragging;
      SetFixedSizeConstraints(Self, Width, Height);
      tmDragScroll.Enabled := TRUE;
      FHost.NotifyBeginDrag;
    end;

    if FDragState = dsDragging then
      UpdateDragWidgetPosition;
  end
  else
    FinishDrag;
end;

procedure TDragSpaceFrame.NotifyMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then
  begin
    try
      if FDraggingEnabled and (FDragState = dsDragging) then
        FHost.NotifyEndDrag;
    finally
      FinishDrag;
    end;
  end;
end;

procedure TDragSpaceFrame.NotifyScroll(VerticalPixels: Integer);
begin
  if (FDragState = dsDragging) and (VerticalPixels <> 0) then
  begin
    FDragStartPos.y := FDragStartPos.y + VerticalPixels;
    UpdateDragWidgetPosition;
  end;
end;

end.

